Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue47/Differ/CGIAPI.pas

Pascal/Delphi Source File | 1999-06-07 | 16.3 KB | 550 lines

{  **************************************************
    Originally written by Steve Troxell for The Delphi
    Magazine. Developing Dynamic Web Pages, Issue 16,
    December 1996
   **************************************************  }
{  **************************************************
    Modifyed by Paul Warren for The Delphi Magazine.
    April 1999.
   **************************************************  }

unit CGIAPI;

interface

uses SysUtils, Windows, Classes, INIFIles;

type
  TEnvironmentType = (etStdCGI, etWinCGI);

  TCGI = class
  private
    FCGIItems: TStringList;
    FFormItems: TStringList;
    FEnvironmentType: TEnvironmentType;
    FOutputFile: TextFile;
    FWinCGIProfileName: string;
    FWinCGIProfile: TINIFile;
    function SearchBuf(Regex: string; const Buffer; Count: integer): integer;
    function UniqueLabelStr(Value: string): string;
  protected
    procedure LoadStdCGIUserData;
    procedure LoadWinCGIUserData;
    procedure LoadMultiCGIUserData;
    procedure UnpackURLString(S: PChar); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure DumpWinCGIProfile;
    function GetEnv(Variable: string): string;
    { commented out by Paul Warren}
    { procedure Write(Value: string);}
    { procedure WriteLn(Value: string);}
    property CGIItems: TStringList read FCGIItems;
    property EnvironmentType: TEnvironmentType read FEnvironmentType;
    property FormItems: TStringList read FFormItems;
    property OutputFile: TextFile read FOutputFile write FOutputFile;
    property WinCGIProfile: TINIFile read FWinCGIProfile;
  end;

var
  CGI: TCGI;

implementation

const
  NumCGIVars = 15;
  UpldrDir = 'c:\temp\';

  { These are the standard names used by the calling application
    to reference CGI variables.  They generally follow the
    WinCGI names. }
  CGIVarNames: array[0..NumCGIVars - 1] of string[31] =
    ('SERVER SOFTWARE',
     'SERVER NAME',
     'SERVER PORT',
     'CGI VERSION',
     'REQUEST PROTOCOL',
     'REQUEST METHOD',
     'LOGICAL PATH',
     'PHYSICAL PATH',
     'EXECUTABLE PATH',
     'QUERY STRING',
     'REMOTE HOST',
     'REMOTE ADDRESS',
     'REMOTE USER',
     'CONTENT LENGTH',
     'CONTENT TYPE');

  { These are the actual variable names used by each protocol. }
  CGIVars: array[0..NumCGIVars - 1, TEnvironmentType] of string[31] =
     { etStdCGI              etWinCGI }
    (
     ('SERVER_SOFTWARE',    'SERVER SOFTWARE'),
     ('SERVER_NAME',        'SERVER NAME'),
     ('SERVER_PORT',        'SERVER PORT'),
     ('GATEWAY_INTERFACE',  'CGI VERSION'),
     ('SERVER_PROTOCOL',    'REQUEST PROTOCOL'),
     ('REQUEST_METHOD',     'REQUEST METHOD'),
     ('PATH_INFO',          'LOGICAL PATH'),
     ('PATH_TRANSLATED',    'PHYSICAL PATH'),
     ('SCRIPT_NAME',        'EXECUTABLE PATH'),
     ('QUERY_STRING',       'QUERY STRING'),
     ('REMOTE_HOST',        'REMOTE HOST'),
     ('REMOTE_ADDR',        'REMOTE ADDRESS'),
     ('REMOTE_USER',        'REMOTE USER'),
     ('CONTENT_LENGTH',     'CONTENT LENGTH'),
     ('CONTENT_TYPE',       'CONTENT TYPE')
     );

{function ParseIt(var ParseStr: string; Delimiter: string): string;
var
  Len: integer;
begin
  Result := '';
  if Length(ParseStr) > 0 then // if there is something to parse...
  begin
    if Pos(Delimiter, ParseStr) = 1 then  // if it begins with a delimiter...
      System.Delete(ParseStr, 1, Length(Delimiter)); // then delete it
    if Pos(Delimiter, ParseStr) <> 0 then  // if there is a delimiter...
    begin
      // copy up to it
      Len := Pos(Delimiter, ParseStr);
      Result := System.Copy(ParseStr, 1, Len-1);
    end else
    begin
      // else copy all remaining string
      Len := Length(ParseStr);
      Result := System.Copy(ParseStr, 1, Len);
    end;
    // delete what we copied
    System.Delete(ParseStr, 1, Len+Length(Delimiter));
  end;
end;}

constructor TCGI.Create;
var
  I: Integer;
begin
  inherited Create;

  FCGIItems := TStringList.Create;
  FFormItems := TStringList.Create;

  { Detect whether we are standard CGI or WinCGI. }
  if GetEnv('SERVER_NAME') <> '' then
    FEnvironmentType := etStdCGI
  else
  begin
    FEnvironmentType := etWinCGI;
    FWinCGIProfileName := ParamStr(1);
    FWinCGIProfile := TINIFile.Create(FWinCGIProfileName);
  end;

  { Assign and open our output file accordingly. }
  case EnvironmentType of
    etStdCGI: AssignFile(OutputFile, '');
    etWinCGI: AssignFile(OutputFile, WinCGIProfile.ReadString('System', 'Output File', ''));
  end;
  Rewrite(OutputFile);

  { commented out by Paul Warren}
  { Write standard HTML header for the output page. }
  { WriteLn('Content-type: text/html');}
  { WriteLn('');}

  { Load CGI variables and user's form variables. }
  case EnvironmentType of
    etStdCGI: begin
                for I := 0 to NumCGIVars - 1 do
                  FCGIItems.Values[CGIVarNames[I]] :=
                    GetEnv(CGIVars[I, etStdCGI]);

                if Pos('multipart/form-data', FCGIItems.Values['CONTENT TYPE']) <> 0 then
                begin
                  FCGIItems.Values['CONTENT BOUNDARY'] :=
                    Copy(FCGIItems.Values['CONTENT TYPE'],
                      Pos('boundary=', FCGIItems.Values['CONTENT TYPE'])+9,
                        Length(FCGIItems.Values['CONTENT TYPE']));
                  LoadMultiCGIUserData;
                end else
                  LoadStdCGIUserData;
              end;
    etWinCGI: begin
                for I := 0 to NumCGIVars - 1 do
                  FCGIItems.Values[CGIVarNames[I]] :=
                    WinCGIProfile.ReadString('CGI', CGIVars[I, etWinCGI], '');

                LoadWinCGIUserData;
              end;
  end;
end;

destructor TCGI.Destroy;
begin
  CloseFile(OutputFile);

  FCGIItems.Free;
  FFormItems.Free;
  FWinCGIProfile.Free;
end;

procedure TCGI.DumpWinCGIProfile;
{ Writes the contents of the WinCGI profile file to the
  response page. }
var
  FCB: TextFile;
  Rec: string;
begin
  if FWinCGIProfile <> nil then
  begin
    AssignFile(FCB, FWinCGIProfileName);
    Reset(FCB);
    try
      while not Eof(FCB) do
      begin
        ReadLn(FCB, Rec);
        WriteLn(Rec + '<BR>');
      end;
    finally
      CloseFile(FCB);
    end;
  end;
end;

function TCGI.GetEnv(Variable: string): string;
{ Returns the value iof the given environment variable. }
var
  EnvVariable: array[0..127] of char;
  EnvBuffer: array[0..1023] of char;
begin
  StrPCopy(EnvVariable, Variable);
  Result := '';
  if GetEnvironmentVariable(PChar(Variable), @EnvBuffer, SizeOf(EnvBuffer)) <> 0 then
    Result := StrPas(EnvBuffer);
end;

procedure TCGI.LoadStdCGIUserData;
{ Reads, parses, and decodes values for the standard CGI form variables. }
var
  ContentLength: LongInt;
  InputFCB: File;
  InputBuffer: PChar;
  RequestMethod: string;
  UserContentBuffer: string;
begin
  RequestMethod := Uppercase(FCGIItems.Values['REQUEST METHOD']);

  { If the form action is a POST, then we get form variables from
    the standard input device. }
  if RequestMethod = 'POST' then
  begin
    if FCGIItems.Values['CONTENT TYPE'] <> '' then
    begin
      ContentLength := StrToInt(FCGIItems.Values['CONTENT LENGTH']);
      AssignFile(InputFCB, '');  { standard input }
      Reset(InputFCB, 1);
      try
        InputBuffer := StrAlloc(ContentLength + 1);
        FillChar(InputBuffer^, ContentLength + 1, #0);
        try
          BlockRead(InputFCB, InputBuffer^, ContentLength);
          UnpackURLString(InputBuffer);
        finally
          StrDispose(InputBuffer);
        end;
      finally
        CloseFile(InputFCB);
      end;
    end;
  end

  { If the form action is GET, then we get form variables from
    from the QUERY STRING variable. }
  else if RequestMethod = 'GET' then
  begin
    UserContentBuffer := FCGIItems.Values['QUERY STRING'];
    InputBuffer := StrAlloc(Length(UserContentBuffer));
    try
      StrPCopy(InputBuffer, UserContentBuffer);
      UnpackURLString(InputBuffer);
    finally
      StrDispose(InputBuffer);
    end;
  end;
end;

// added by Paul Warren
{ SearchBuf - execute search on Buffer, modified Boyer-Moore }
function TCGI.SearchBuf(Regex: string; const Buffer; Count: integer): integer;
var
  i, j: integer;
  M, N: integer;
  Skip: array[Char] of integer;

  procedure InitSkip;
  var
    Ch: Char;
    i: Integer;
  begin
    for Ch := Low(Char) to High(Char) do Skip[Ch] := M;
    for i := 1 to M do Skip[Regex[i]] := M - i;
  end;

  function BufChar(Index: integer): Char;
  begin
     Result := Chr(TByteArray(Buffer)[Index-1]);
  end;

begin
  Result := -1; { return -1 if unsuccessful }
  if (Count = 0) or (Regex = '') then exit;
  M := Length(Regex);
  N := Count + 1;
  i := M; j := M;
  InitSkip;
  repeat
    if (BufChar(i) = Regex[j]) then begin
      Dec(i);
      Dec(j);
    end else begin
      if M - j + 1 > Skip[BufChar(i)] then
        i := i + M - j + 1
      else
        i := i + Skip[BufChar(i)];
      j := M;
    end;
  until (j < 1) or (i > N); { found something or reached end }
  if (i > N) then
    Result := -1  { no match - reached end }
  else
    Result := i;  { match begining at i }
end;

procedure TCGI.LoadMultiCGIUserData;
{ Reads, parses, and decodes values for the standard CGI
  form variables in a multipart form. }
const
  Eom: boolean = false;
  FileCounter: integer = 0;
var
  ContentLength: LongInt;
  InputFCB: File;
  RequestMethod: string;
  S: string;
  LabelStr: String;
  LastLabelStr: String;
  ValueStr: String;
  Buffer: array of char;
  AttachStream: TMemoryStream;
  UniqueFileName: string;

  function read1ln(var Value: string): integer;
  begin
    Result := SearchBuf(#13#10, Buffer[0], ContentLength)+2;
    SetLength(Value, Result);
    Move(Buffer[0], Value[1], Result);
    Move(Buffer[Result], Buffer[0], Length(Buffer)-Result);
  end;

  function readAttachment: integer;
  begin
    Result := SearchBuf(#13#10'--'+CGIItems.Values['CONTENT BOUNDARY'], Buffer[0], ContentLength);
    AttachStream.Write(Buffer[0], Result);
    Move(Buffer[Result], Buffer[0], Length(Buffer)-Result);
  end;

begin
  RequestMethod := Uppercase(FCGIItems.Values['REQUEST METHOD']);
  if RequestMethod = 'POST' then
  begin
    if FCGIItems.Values['CONTENT TYPE'] <> '' then
    begin
      ContentLength := StrToInt(FCGIItems.Values['CONTENT LENGTH']);
      AssignFile(InputFCB, '');  { standard input }
      Reset(InputFCB, 1);
      try
        SetLength(Buffer, ContentLength);
        BlockRead(InputFCB, Buffer[0], ContentLength);
        while not Eom do
        begin
          read1ln(S); // read a line

          if S <> #13#10 then
          begin
            while true do
            begin
              if Pos('Content-Disposition', S) <> 0 then
              begin
                System.Delete(S, 1, Pos('"', S)); // delete to first "
                LabelStr := System.Copy(S, 1, Pos('"', S)-1); // copy name
                System.Delete(S, 1, Pos('"', S)); // delete name
                if Pos('FILENAME', uppercase(S)) <> 0 then
                begin
                  LabelStr := UniqueLabelStr('FILENAME');
                  LastLabelStr := LabelStr;
                  System.Delete(S, 1, Pos('"', S)); // delete to filename
                  ValueStr := System.Copy(S, 1, Pos('"', S)-1); // copy value

                  if ValueStr <> '' then
                  begin
                    FFormItems.Values[LabelStr] := ValueStr;
                    LabelStr := '';
                    ValueStr := '';
                  end;

                  read1ln(S); // read another line

                  if Pos('Content-Type', S) <> 0 then
                  begin
                    LabelStr := UniqueLabelStr('CONTENT-TYPE');
                    System.Delete(S, 1, Pos(':', S)+1); // delete to :
                    ValueStr := System.Copy(S, 1, Length(S)); // copy name

                    if ValueStr <> '' then
                    begin
                      FFormItems.Values[LabelStr] := ValueStr;
                      LabelStr := '';
                      ValueStr := '';
                    end;

                    read1ln(S); // read another line
                  end;

                  if S = #13#10 then  // if there is content...
                  begin
                    AttachStream := TMemoryStream.Create;
                    try
                      // copy to memory stream
                      readAttachment;
                      // create new file name
                      UniqueFileName := UpldrDir+ChangeFileExt(ExtractFileName(
                        FFormItems.Values[LastLabelStr]), '')+FloatToStr(
                          TimeStampToMSecs(DateTimeToTimeStamp(Time)))+IntToStr(FileCounter)+
                            ExtractFileExt(FFormItems.Values[LastLabelStr]);
                      // write file to disk
                      AttachStream.SaveToFile(UniqueFileName);
                      // save temp file name as form variable
                      FFormItems.Values[UniqueLabelStr('TEMPFILE')] := UniqueFileName;
                      Inc(FileCounter);
                    finally
                      AttachStream.Free;
                    end;
                  end;

                end;
                Break;
              end;
              if Pos(CGIItems.Values['CONTENT BOUNDARY'], S) <> 0 then
              begin
                // remove first 2 chars
                System.Delete(S, 1, 2);
                // check for Eom
                System.Delete(S, 1, Length(CGIItems.Values['CONTENT BOUNDARY']));
                if S = '--'#13#10 then Eom := true;
                Break;
              end;
              ValueStr := ValueStr + S; // append to valuestr
              read1ln(S); // read another line
            end;
          end;
          if ValueStr <> '' then
          begin
            // remove CRLFs from the end
            FFormItems.Values[LabelStr] := System.Copy(ValueStr, 1, Length(ValueStr)-2);
            LabelStr := '';
            ValueStr := '';
          end;
        end;
      finally
        CloseFile(InputFCB);
      end;
    end;
  end;
end;

function TCGI.UniqueLabelStr(Value: string): string;
var
  Counter: integer;
begin
  Result := Value;
  Counter := 0;
  while FFormItems.IndexOfName(Result) <> -1 do
  begin
    Inc(Counter);
    Result := Result+IntToStr(Counter);
  end;
end;
// end of addition

procedure TCGI.LoadWinCGIUserData;
{ Copies values for WinCGI form variables. }
begin
  { All form variables are found in the [Form Literal] section of
    the profile file. }
  WinCGIProfile.ReadSectionValues('Form Literal', TStrings(FFormItems));
end;

procedure TCGI.UnpackURLString( S: PChar );
{ Parses and decodes a URL-encoded string.  Copies variable values into
  the FFormItems field. }
var
  LabelStr: String;
  ValueStr: String;
  Counter: integer;
begin
  Counter := 0;
  LabelStr := '';
  ValueStr := '';
  while S^ <> #0 do
  begin
    case S^ of
      '+' : ValueStr := ValueStr + ' ';
      '%' : begin
              ValueStr := ValueStr + Chr(StrToInt('$' + (S + 1)^ + (S + 2)^));
              Inc(S, 2);
            end;
      '=' : if LabelStr = '' then
            begin
              LabelStr := ValueStr;
              ValueStr := '';
            end;
      '&' : begin
              while FFormItems.IndexOfName(LabelStr) <> -1 do
              begin
                LabelStr := LabelStr+IntToStr(Counter);
                Inc(Counter);
              end;
              FFormItems.Values[LabelStr] := ValueStr;
              ValueStr := '';
              LabelStr := '';
            end;
      else ValueStr := ValueStr + S^;
    end;
    Inc(S);
  end;

  if ValueStr <> '' then
    FFormItems.Values[UniqueLabelStr(LabelStr)] := ValueStr;
end;

{ Commented out by Paul Warren}

(*procedure TCGI.Write(Value: String);
{ Standard Write to the output page. }
begin
  System.Write(OutputFile, Value);
end;

procedure TCGI.WriteLn(Value: String);
{ Standard WriteLn to the output page. }
begin
  System.WriteLn(OutputFile, Value);
end;*)

initialization
  CGI := TCGI.Create;
finalization
  CGI.Free;
end.